unit uProtoBuf;

interface

const
  HEADER = 29099;
  
type
  TWireType = (wtVarint=0, wtFixed64Bit=1, wtLengthDelimited=2, wtFixed32Bit=3);

  TByteStream = class(TObject)
  private
    FDataPtr: PByte;
    FPosition: Cardinal;
    FLength: Cardinal;
    FCapacity: Cardinal;    
    function Get(Index: Integer): Byte;
    procedure Put(Index: Integer; Item: Byte);
    procedure Grow(needSpace: Cardinal);
    function GetBytesAvailable: Cardinal;
  public
    constructor Create;
    destructor Destroy; override;
    procedure WriteByte(value: Byte);
    procedure WriteBytes(value: TByteStream); overload;
    procedure WriteBytes(value: TByteStream; pos: Cardinal; len: Cardinal); overload;
    procedure WriteDouble(value: Double);
    procedure WriteShort(value: Word);
    procedure WriteString(const value: string);
    procedure WriteUtf8String(const value: string);
    procedure WriteInt(value: Integer);
    procedure WriteUInt(value: Cardinal);
    procedure WriteInt64(value: Int64);
    function ReadUInt: Cardinal;

    property Position: Cardinal read FPosition write FPosition;
    property Length: Cardinal read FLength;
    property BytesAvailable: Cardinal read GetBytesAvailable;
    property Data[Index: Integer]: Byte read Get write Put; default;
    property DataPtr: PByte read FDataPtr;
  end;

  TPackageOut = class(TByteStream)
  private
    FCode: Word;
    FCheckSum: Integer;
  public
    constructor Create(code: Word; arg1: Integer=0; arg2: Integer=0; arg3: Integer=0);
    destructor Destroy; override;
    procedure pack;
    function calculateCheckSum: Integer;

    property Code: Word read FCode;
  end;

  TPackageIn = class(TByteStream)
  end;

  TWritingBuffer = class(TByteStream)
  private
    FSlices: TByteStream;
  public
    constructor Create;
    destructor Destroy; override;
    function BeginBlock: Cardinal;
    procedure EndBlock(beginSliceIndex: Cardinal);
    procedure ToNormal(output: TByteStream);
  end;

  TWriteUtiles = class
  public
    class procedure WriteVarint64(writeBuf: TWritingBuffer; arg1: Int64);
    class procedure WriteTag(writeBuf: TWritingBuffer; wt: TWireType; arg1: Integer);
    class procedure WriteDouble(writeBuf: TWritingBuffer; arg1: Double);
    class procedure WriteInt64(writeBuf: TWritingBuffer; arg1: Int64);
    class procedure WriteInt(writeBuf: TWritingBuffer; arg1: Integer);
    class procedure WriteFixed64(writeBuf: TWritingBuffer; arg1: Int64);
    class procedure WriteFiexed32(writeBuf: TWritingBuffer; arg1: Integer);
    class procedure WriteBool(writeBuf: TWritingBuffer; arg1: Boolean);
    class procedure WriteString(writeBuf: TWritingBuffer; arg1: string);
    class procedure WriteBytes(writeBuf: TWritingBuffer; arg1: TByteStream);
    class procedure WriteUint32(writeBuf: TWritingBuffer; arg1: Cardinal);
  end;
  
var
  G_ClientID: Integer;
  
implementation

uses
  Windows,
  SysUtils;
  
{ TByteStream }

function TByteStream.Get(Index: Integer): Byte;
begin
  if (Index < 0) or (Index >= FLength) then
    raise Exception.Create(Format('TByteStream index out of bounds (%d)', [Index]));
  Result := Byte(PChar(FDataPtr)[Index]);
end;

procedure TByteStream.Put(Index: Integer; Item: Byte);
begin
  if (Index < 0) or (Index >= FLength) then
    raise Exception.Create(Format('TByteStream index out of bounds (%d)', [Index]));
  PChar(FDataPtr)[Index] := char(Item);
end;

procedure TByteStream.Grow(needSpace: Cardinal);
begin
  if FCapacity-FLength > needSpace then
    Inc(FLength, needSpace)
  else
  begin
    Inc(FLength, needSpace);
    Inc(FCapacity, needSpace + 64);
    ReallocMem(FDataPtr, FCapacity);
  end;
end;

function TByteStream.GetBytesAvailable: Cardinal;
begin
  result := FLength - FPosition;
end;

constructor TByteStream.Create;
begin
  inherited;
  FPosition := 0;
  FLength := 0;
  FCapacity := 10;
  GetMem(FDataPtr, 10);
end;

destructor TByteStream.Destroy;
begin
  if FCapacity>0 then
    FreeMem(FDataPtr);
  inherited;
end;

procedure TByteStream.WriteByte(value: Byte);
begin
  if FLength-FPosition <= Sizeof(Byte) then
    Grow(Sizeof(Byte));
  Data[FPosition] := value;
  Inc(FPosition, Sizeof(Byte));
end;

procedure TByteStream.WriteBytes(value: TByteStream);
var
  p: PByte;
begin
  if value.Length=0 then
    Exit;

  if FLength-FPosition <= value.Length then
    Grow(value.Length);
  p := FDataPtr;Inc(p, FPosition);
  Move(value.DataPtr^, p^, value.Length);
  Inc(FPosition, value.Length);
end;

procedure TByteStream.WriteBytes(value: TByteStream; pos: Cardinal; len: Cardinal);
var
  p1, p2: PByte;
  {$IFDEF DEBUG}
  deBuf: array[0..1024] of char;
  {$ENDIF}   
begin
  if Len=0 then
    Exit;
  if value.Length-pos < len then
    Raise Exception.Create('[error]TByteStream.WriteBytes2');

  if FLength-FPosition <= Len then
    Grow(Len);
  p1 := value.DataPtr; Inc(p1, Pos);
  p2 := FDataPtr; Inc(p2, FPosition);
  Move(p1^, p2^, Len);
  Inc(FPosition, len);
  {$IFDEF DEBUG}
  FillChar(deBuf, Sizeof(deBuf), 0);
  Move(FDataPtr^, debuf, FLength);
  {$ENDIF}  
end;

procedure TByteStream.WriteDouble(value: Double);
begin
  WriteInt64(Pint64(@value)^);
end;

procedure TByteStream.WriteShort(value: Word);
begin
  if FLength-FPosition <= Sizeof(Word) then
    Grow(Sizeof(Word));
  Data[FPosition + 0] := HiByte(value);
  Data[FPosition + 1] := LoByte(value);
  Inc(FPosition, Sizeof(Word));
end;

procedure TByteStream.WriteString(const value: string);
var
  p: PByte;
  sLen: Cardinal;
begin
  sLen := System.Length(value);
  if sLen=0 then
    Exit;

  if FLength-FPosition <= sLen then
    Grow(sLen);
  p := FDataPtr; Inc(p, FPosition);
  Move(PChar(value)^, p^, sLen);
  Inc(FPosition, sLen);
end;

procedure TByteStream.WriteUtf8String(const value: string);
begin
  WriteString(Utf8Encode(value));
end;

procedure TByteStream.WriteInt(value: Integer);
begin
  WriteShort(HiWord(value));
  WriteShort(LoWord(value));
end;

procedure TByteStream.WriteUInt(value: Cardinal);
begin
  WriteShort(HiWord(value));
  WriteShort(LoWord(value));
end;

procedure TByteStream.WriteInt64(value: Int64);
begin
  WriteInt(value shr 32);
  WriteInt(Integer(value));
end;

function TByteStream.ReadUInt: Cardinal;
begin
  if FLength-FPosition >= Sizeof(Cardinal) then
  begin
    Result := MakeLong(MakeWord(Data[FPosition + 3], Data[FPosition + 2]),
                       MakeWord(Data[FPosition + 1], Data[FPosition + 0]));
    Inc(FPosition, Sizeof(Cardinal));
  end else
    Raise Exception.Create('[error]TByteStream.ReadUInt');
end;
{ TPackageOut }

constructor TPackageOut.Create(code: Word; arg1, arg2, arg3: Integer);
begin
  inherited Create;
  WriteShort(HEADER);
  WriteShort(0);
  WriteShort(0);
  WriteShort(code);
  if arg1 = 0 then              
    arg1 := G_ClientID;
  WriteInt(arg1);
  WriteInt(arg2);
  WriteInt(arg3);
  FCode := code;
  FCheckSum := 0;
end;

destructor TPackageOut.Destroy;
begin
  inherited;
end;

procedure TPackageOut.pack;
begin
  FCheckSum := calculateCheckSum;
  Data[2] := HiByte(FLength);
  Data[3] := LoByte(FLength);
  Data[4] := HiByte(FCheckSum);
  Data[5] := LoByte(FCheckSum);
end;

function TPackageOut.calculateCheckSum: Integer;
var
  i: Integer;
begin
  result := 119;
  for i := 6 to FLength - 1 do
    Result := result + Data[i];
  result := result and 32639;
end;

{ TWritingBuffer }
constructor TWritingBuffer.Create;
begin
  inherited;
  FSlices := TByteStream.Create;
end;

destructor TWritingBuffer.Destroy;
begin
  FSlices.Free;
  inherited;
end;

function TWritingBuffer.BeginBlock: Cardinal;
begin
  FSlices.WriteUInt(Position);
  Result := FSlices.Length;
  if FSlices.Length mod 6 <> 4 then
    Raise Exception.Create('[error]TWritingBuffer.BeginBlock');
  FSlices.WriteDouble(0);
  FSlices.WriteUInt(Position);
end;

//4|8|4|4|4  init pos|Length_SPos|Length_EPos|Data_SPos|Data_EPos|end pos
procedure TWritingBuffer.EndBlock(beginSliceIndex: Cardinal);
var
  beginPosition: Cardinal;
begin
  if FSlices.Length mod 8 <> 0 then
    Raise Exception.Create('[error]TWritingBuffer.EndBlock');
  FSlices.WriteUInt(Position);
  FSlices.Position := beginSliceIndex + 8;
  beginPosition := FSlices.ReadUInt;
  FSlices.Position := beginSliceIndex;
  FSlices.WriteUInt(Position);
  TWriteUtiles.WriteUint32(self, Position - beginPosition);
  FSlices.WriteUInt(Position);
  FSlices.Position := FSlices.Length;
  FSlices.WriteUInt(Position);
end;

procedure TWritingBuffer.ToNormal(output: TByteStream);
var
  beginIndex, endIndex: Cardinal;
  {$IFDEF DEBUG}
  deBuf: array[0..1024] of char;
  {$ENDIF}
begin
  if FSlices.Length mod 8 <> 0 then
    Raise Exception.Create('[error]TWritingBuffer.ToNormal');
  beginIndex := 0;
  endIndex := 0;
  FSlices.Position := 0;
  {$IFDEF DEBUG}
  FillChar(deBuf, Sizeof(deBuf), 0);
  Move(FDataPtr^, debuf, Length);
  {$ENDIF}
  while FSlices.BytesAvailable > 0 do
  begin
    endIndex := FSlices.ReadUInt;
    if endIndex > beginIndex then
      output.WriteBytes(self, beginIndex, endIndex - beginIndex)
    else if endIndex < beginIndex then
      Raise Exception.Create('[error]TWritingBuffer.ToNormal2');
    beginIndex := FSlices.ReadUInt;
  end;
  if beginIndex < length then
    Output.WriteBytes(self, beginIndex, Length - beginIndex);
  {$IFDEF DEBUG}
  FillChar(deBuf, Sizeof(deBuf), 0);
  Move(Output.DataPtr^, debuf, Length);
  {$ENDIF}    
end;

{ TWriteUtiles }

class procedure TWriteUtiles.WriteVarint64(writeBuf: TWritingBuffer; arg1: Int64);
begin
//  if arg1
  Raise Exception.Create('error');
end;

class procedure TWriteUtiles.WriteTag(writeBuf: TWritingBuffer; wt: TWireType;
  arg1: Integer);
begin
  WriteUint32(writeBuf, (arg1 shl 3) or Ord(wt));
end;

class procedure TWriteUtiles.WriteDouble(writeBuf: TWritingBuffer; arg1: Double);
begin
  writeBuf.WriteDouble(arg1);
end;

class procedure TWriteUtiles.WriteInt64(writeBuf: TWritingBuffer; arg1: Int64);
begin
  Raise Exception.Create('error');
end;

class procedure TWriteUtiles.WriteInt(writeBuf: TWritingBuffer; arg1: Integer);
begin
  if arg1 < 0 then
    WriteVarint64(writeBuf, arg1)
  else
    WriteUint32(writeBuf, arg1);
end;

class procedure TWriteUtiles.WriteFixed64(writeBuf: TWritingBuffer; arg1: Int64);
begin
  Raise Exception.Create('error');
end;

class procedure TWriteUtiles.WriteFiexed32(writeBuf: TWritingBuffer;
  arg1: Integer);
begin
  Raise Exception.Create('error');
end;

class procedure TWriteUtiles.WriteBool(writeBuf: TWritingBuffer; arg1: Boolean);
begin
  if arg1 then
    writeBuf.WriteByte(1)
  else
    writeBuf.WriteByte(0);
end;

class procedure TWriteUtiles.WriteString(writeBuf: TWritingBuffer; arg1: string);
var
  pos: Cardinal;
begin
  pos := writeBuf.BeginBlock;
  writeBuf.WriteUtf8String(arg1);
  writeBuf.EndBlock(Pos);
end;

class procedure TWriteUtiles.WriteBytes(writeBuf: TWritingBuffer;
  arg1: TByteStream);
begin
  WriteUint32(writeBuf, arg1.Length);
  writeBuf.WriteBytes(arg1);
end;

class procedure TWriteUtiles.WriteUint32(writeBuf: TWritingBuffer; arg1: Dword);
begin
  while true do
  begin
    if (arg1 and (not 127)) = 0 then
    begin
      writeBuf.WriteByte(arg1);
      Exit;
    end;
    writeBuf.WriteByte(arg1 and 127 or 128);
    arg1 := arg1 shr 7;
  end;
end;

end.
